home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_s.arc / ICONX.ARC / FMEMMON.C < prev    next >
Encoding:
C/C++ Source or Header  |  1990-03-28  |  14.3 KB  |  589 lines

  1. /*
  2.  *  fxmemmon.c -- mmout, mmpause, mmshow, and internal functions.
  3.  *
  4.  *   This file contains memory monitoring code.  It is compiled by inclusion
  5.  *   in fxtra.c if MemMon is defined.  When MemMon is undefined, most of the
  6.  *   "MMxxxx" entry points are defined as null macros in rt.h.
  7.  */
  8.  
  9. #include "..\h\config.h"
  10. #include "..\h\rt.h"
  11. #include "rproto.h"
  12.  
  13.  
  14.  
  15. #ifdef MemMon
  16. /*
  17.  * Prototypes.
  18.  */
  19.  
  20. hidden    novalue mmcmd        Params((word addr, word len, int c));
  21. hidden    novalue mmdec        Params((uword n));
  22. hidden    novalue mmforget    Params((noargs));
  23. hidden    novalue mmlen        Params((word n, int c));
  24. hidden    novalue mmnewline    Params((noargs));
  25. hidden    novalue mmrefresh    Params((noargs));
  26. hidden    novalue mmsizes        Params((int c));
  27. hidden    novalue mmstatic    Params((noargs));
  28. hidden    novalue MMOut        Params((char *prefix, char *msg));
  29.  
  30. static FILE *monfile = NULL;    /* output file pointer */
  31. static char *monname = NULL;    /* output file name */
  32.  
  33. static word llen = 0;        /* current output line length */
  34.  
  35. static char typech[MaxType+1];    /* output character for each type */
  36.  
  37. /* Define size of curlength table, and bias needed to access it. */
  38. /* Assumes all type codes are printable characters (or space).   */
  39. /* Smaller table is used if not EBCDIC.                          */
  40. #if !EBCDIC
  41. #define CurSize (127 - ' ')
  42. #define CurBias ' '
  43. #else                    /* !EBCDIC */
  44. #define CurSize 256
  45. #define CurBias 0
  46. #endif                    /* !EBCDIC */
  47.  
  48. static word curlength[CurSize];    /* current length for each output character */
  49.  
  50. /* line limit: start a new line when a command goes beyond this column */
  51. #define LLIM 70
  52.  
  53. /* mmchar(c): output character c and update the column counter */
  54. #define mmchar(c) (llen++,putc((c),monfile))
  55.  
  56. /* mmspace(): output unneeded whitespace whitespace following a command */
  57. /*  define as "mmchar(' ')" for readable files, or as "0" for compact ones */
  58. #define mmspace() 0
  59.  
  60. /*
  61.  * mmout(s) - write the given string to the MemMon file.
  62.  */
  63.  
  64. FncDcl(mmout,1)
  65.    {
  66.    char sbuf[MaxCvtLen];
  67.    int t;
  68.  
  69.    if ((t = defstr(&Arg1, sbuf, &emptystr)) == Error) 
  70.       RunErr(0, NULL);
  71.    /*
  72.     * Make sure Arg1 is a C-style string.
  73.     */
  74.    if (t == NoCvt)
  75.       qtos(&Arg1, sbuf);
  76.    MMOut("", StrLoc(Arg1));
  77.    Arg0 = nulldesc;
  78.    Return;
  79.    }
  80.  
  81. /*
  82.  * mmpause(s) - pause MemMon displaying string s.
  83.  */
  84.  
  85. FncDcl(mmpause,1)
  86.    {
  87.    char sbuf[MaxCvtLen];
  88.    int t;
  89.  
  90.    if ((t = defstr(&Arg1, sbuf, &emptystr)) == Error) 
  91.       RunErr(0, NULL);
  92.    if (StrLen(Arg1) == 0)
  93.       MMOut("; ", "programmed pause");
  94.    else {
  95.       /*
  96.        * Make sure Arg1 is a C-style string.
  97.        */
  98.       if (t == NoCvt)
  99.          qtos(&Arg1, sbuf);
  100.       MMOut("; ", StrLoc(Arg1));
  101.       }
  102.    Arg0 = nulldesc;
  103.    Return;
  104.    }
  105.  
  106. /*
  107.  * mmshow(x, s) - alter MemMon display of x depending on s.
  108.  */
  109.  
  110. FncDcl(mmshow,2)
  111.    {
  112.    char sbuf[MaxCvtLen];
  113.  
  114.    /*
  115.     * Default Arg2 to the empty string and make sure it is a C-style string.
  116.     */
  117.    switch (defstr(&Arg2, sbuf, &emptystr)) {
  118.  
  119.       case Cvt:   /* Already converted to a C-style string */
  120.          break;
  121.  
  122.       case Defaulted:
  123.       case NoCvt:
  124.          qtos(&Arg2, sbuf);
  125.          break;
  126.  
  127.       case Error:
  128.          RunErr(0, NULL);
  129.       }
  130.  
  131.    MMShow(&Arg1, StrLoc(Arg2));
  132.    Arg0 = nulldesc;
  133.    Return;
  134.    }
  135.  
  136. /*
  137.  * MMInit(filename) - initialization.
  138.  *
  139.  *  Memory monitoring is activated if the environment variable MEMMON is
  140.  *  non-null.  Its value names the output file;  or, under Unix, a value
  141.  *  beginning with "|" specifies a command to which the output is piped.
  142.  *
  143.  *  If MemMon is defined on a system lacking environment variables,
  144.  *  monitoring is always activated and output is to the file "memmon.out".
  145.  */
  146.  
  147. novalue MMInit(filename)
  148. char *filename;
  149.    {
  150.    int i;
  151.    FILE *f;
  152.    char time_buf[26];
  153.  
  154. #ifdef EnvVars
  155.    monname = getenv("MEMMON");
  156.    if (monname == NULL || strlen(monname) == 0)
  157.       return;
  158. #else                    /* EnvVars */
  159.    monname = "memmon.out";
  160. #endif                    /* EnvVars */
  161.  
  162. #if UNIX
  163.    if (monname[0] == '|')
  164.       f = popen(monname+1, WriteText);
  165.    else
  166. #endif                    /* UNIX */
  167.  
  168.       f = fopen(monname, WriteText);
  169.  
  170.    if (f == NULL) {
  171.       fprintf(stderr, "MEMMON: cannot open %s\n", monname);
  172.       fflush(stderr);
  173.       exit(ErrorExit);
  174.       }
  175.  
  176.  
  177.    getctime(time_buf);
  178.    fprintf(f, "##  Icon MemMon output\n");
  179.    fprintf(f, "#\n");
  180.    fprintf(f, "#   program: %s\n", filename);
  181.    fprintf(f, "#   date:    %s\n", time_buf);
  182.  
  183.    for (i = 0; i <= MaxType; i++)
  184.       typech[i] = '?';    /* initialize with error character */
  185.  
  186. #ifdef LargeInts
  187.    typech[T_Bignum]  = 'i';    /* long integer */
  188. #endif                    /* LargeInts */
  189.  
  190.    typech[T_Real]    = 'r';    /* real number */
  191.    typech[T_Cset]    = 'c';    /* cset */
  192.    typech[T_File]    = 'f';    /* file block */
  193.    typech[T_Record]  = 'R';    /* record block */
  194.    typech[T_Tvsubs]  = 'u';    /* substring trapped variable */
  195.    typech[T_External]= 'E';    /* external block */
  196.  
  197.    typech[T_List]    = 'L';    /* list header block */
  198.    typech[T_Lelem]   = 'l';    /* list element block */
  199.  
  200.    typech[T_Table]   = 'T';    /* table header block */
  201.    typech[T_Telem]   = 't';    /* table element block */
  202.    typech[T_Tvtbl]   = 'e';    /* table elem trapped variable*/
  203.  
  204.    typech[T_Set]     = 'S';    /* set header block */
  205.    typech[T_Selem]   = 's';    /* set element block */
  206.  
  207.    typech[T_Slots]   = 'h';    /* set/table hash slots */
  208.  
  209.    typech[T_Coexpr]  = 'X';    /* co-expression block (static region) */
  210.    typech[T_Refresh] = 'x';    /* co-expression refresh block */
  211.  
  212.    /*
  213.     * codes used elsewhere but not shown here:
  214.     *    in the static region: 'A' = alien (malloc block), 'F' = free
  215.     *    in the string region: '"' = string
  216.     */
  217.  
  218.    /*
  219.     * Set monfile to indicate that memmon is active.  Don't set it earlier
  220.     * than this, or we'll loop trying to trace the garbage collection that
  221.     * creates the buffer space.
  222.     */
  223.    monfile = f;
  224.    mmrefresh();            /* show current state */
  225.    fflush(monfile);        /* force it out */
  226.    }
  227.  
  228. /*
  229.  * MMTerm(part1, part2) - terminate memory monitoring.
  230.  *  part1 and part2 are concatentated to form an explanatory message.
  231.  */
  232.  
  233. novalue MMTerm(part1, part2)
  234. char *part1, *part2;
  235.    {
  236.    FILE *f;
  237.  
  238.    if (monfile == NULL)
  239.       return;
  240.    mmnewline();
  241.    mmsizes('=');        /* make a final check on region sizes */
  242.  
  243.    if (*part1 || *part2)    /* if any reason given, write it as comment */
  244.       fprintf(monfile, "# %s%s\n", part1, part2);
  245.  
  246.    f = monfile;
  247.    monfile = NULL;    /* so we don't try to show the freeing of the buffer */
  248.  
  249. #if UNIX
  250.    if (monname[0] == '|')
  251.       pclose(f);
  252.    else
  253. #endif                    /* UNIX */
  254.       fclose(f);
  255.    }
  256.  
  257. /*
  258.  * MMStat(a, n, c) - note static block at a, length n, represented by char 'c'.
  259.  * Output values are in basic units (typically words).
  260.  */
  261. novalue MMStat(a, n, c)
  262. char *a;
  263. word n;
  264. int c;
  265.    {
  266. #ifndef FixedRegions
  267.    if (monfile == NULL)
  268.       return;
  269.    mmcmd(DiffPtrs(a, statbase) / MMUnits, n / MMUnits, c);
  270. #endif                    /* FixedRegions */
  271.    }
  272.  
  273. /*
  274.  * MMAlc(len, type) - note an allocation at the end of the block region.
  275.  */
  276.  
  277. novalue MMAlc(len, type)
  278. word len;
  279. int type;
  280.    {
  281.    if (monfile == NULL)
  282.       return;
  283.    mmcmd((word)(-1), len / MMUnits, typech[type]);
  284.    }
  285.  
  286. /*
  287.  * MMStr(len) - note a string allocation at the end of the string region.
  288.  */
  289.  
  290. novalue MMStr(slen)
  291. word slen;
  292.    {
  293.    if (monfile == NULL)
  294.       return;
  295.    mmcmd((word)(-1), slen, '"');
  296.    }
  297.  
  298. /*
  299.  * MMBGC() - begin garbage collection.
  300.  */
  301.  
  302. novalue MMBGC(region)
  303. int region;
  304.    {
  305.    if (monfile == NULL)
  306.       return;
  307.    mmsizes('=');            /* write current sizes */
  308.    fprintf(monfile, "%d{\n", region);    /* indicate start of g.c. */
  309.    fflush(monfile);
  310.    mmforget();                /* clear memory of block sizes */
  311.    }
  312.  
  313. /*
  314.  * MMEGC() - end garbage collection.
  315.  */
  316.  
  317. novalue MMEGC()
  318.    {
  319.    if (monfile == NULL)
  320.       return;
  321.    mmnewline();
  322.    fprintf(monfile, "}\n");    /* indicate end of marking */
  323.    mmrefresh();            /* redraw regions after compaction */
  324.    fprintf(monfile, "!\n");    /* indicate end of g.c. */
  325.    fflush(monfile);
  326.    }
  327.  
  328. /*
  329.  * MMMark(block, type) - mark indicated block during garbage collection.
  330.  */
  331.  
  332. novalue MMMark(block, type)
  333. char *block;
  334. int type;
  335.    {
  336.    if (monfile == NULL)
  337.       return;
  338.    mmcmd(DiffPtrs(block, blkbase) / MMUnits, (word)BlkSize(block) / MMUnits,
  339.       typech[type]);
  340.    }
  341.  
  342. /*
  343.  * MMSMark - Mark String.
  344.  */
  345.  
  346. novalue MMSMark(saddr, slen)
  347. char *saddr;
  348. word slen;
  349.    {
  350.    if (monfile == NULL)
  351.       return;
  352.    mmcmd(DiffPtrs(saddr, strbase), slen, '"');
  353.    }
  354.  
  355. /*
  356.  * MMOut(prefix, msg) - write the prefix and message to the MemMon output file.
  357.  */
  358.  
  359. static novalue MMOut(prefix, msg)
  360. char *prefix, *msg;
  361.    {
  362.    if (monfile == NULL)
  363.       return;
  364.    mmnewline();
  365.    fprintf(monfile, "%s%s\n", prefix, msg);
  366.    }
  367.  
  368. /*
  369.  * MMShow(d, s) - redraw block indicated by descriptor d according to flags
  370.  *  in s.
  371.  */
  372.  
  373. novalue MMShow(d, s)
  374. dptr d;
  375. char *s;
  376.    {
  377.    char *block;
  378.    uword addr;
  379.    word len;
  380.    char cmd, tch;
  381.  
  382.    if (monfile == NULL)
  383.       return;
  384.    if (Qual(*d)) {
  385.       /*
  386.        *  Show a string.
  387.        */
  388. /*
  389.       if ((uword)StrLoc(*d)<(uword)strbase || (uword)StrLoc(*d)>=(uword)strend)
  390. */
  391.       if (!InRange(strbase,StrLoc(*d),strend))
  392.          return;    /* ignore if outside string region */
  393.       addr = DiffPtrs(StrLoc(*d), strbase);
  394.       len = StrLen(*d);
  395.       cmd = '$';
  396.       tch = '"';
  397.       }
  398.    else if (Type(*d)==T_Coexpr) {
  399.       /*
  400.        *  Show a coexpression block, which will be in the static region.
  401.        */
  402.       block = (char *)BlkLoc(*d);
  403.       addr = DiffPtrs(block, statbase) / MMUnits;
  404.       len = BlkSize(block) / MMUnits;
  405.       cmd = 'Y';
  406.       tch = typech[T_Coexpr];
  407.       }
  408.    else if (Pointer(*d)) {
  409.       /*
  410.        *  Show something in the block region.
  411.        */
  412.       block = (char *)BlkLoc(*d);
  413. /*
  414.       if ((uword)block < (uword)blkbase || (uword)block >= (uword)blkfree)
  415. */
  416.       if (!InRange(blkbase,block,blkfree))
  417.          return;    /* ignore if outside block region */
  418.       addr = DiffPtrs(block, blkbase) / MMUnits;
  419.       len = BlkSize(block) / MMUnits;
  420.       cmd = '%';
  421.       tch = typech[Type(*d)];
  422.       }
  423.  
  424.    mmdec(addr);            /* address */
  425.    mmchar('+');
  426.    mmlen(len, cmd);        /* length, and $ Y or % command */
  427.    if (s && *s)
  428.       mmchar(*s);        /* color flag from mmshow call */
  429.    else 
  430.       mmchar('r');        /* default color is 'r' (redraw) */
  431.    mmchar(tch);            /* block type character */
  432.    if (llen >= LLIM)
  433.       mmnewline();
  434.    else
  435.       mmspace();
  436.    }
  437.  
  438. /*
  439.  * mmrefresh() - redraw screen, initially or after garbage collection.
  440.  */
  441.  
  442. static novalue mmrefresh()
  443.    {
  444.    char *p;
  445.    word n;
  446.  
  447.    mmnewline();
  448.    mmsizes('<');            /* signal start of screen refresh */
  449.    mmnewline();
  450.    mmforget();                /* clear memory of past sizes */
  451.    mmstatic();                /* show the static region */
  452.    mmnewline();
  453.    for (p = blkbase; p < blkfree; p += n)
  454.       MMAlc(n = BlkSize(p), (int)BlkType(p));/* block region */
  455.    mmnewline();
  456.    MMStr(DiffPtrs(strfree, strbase));    /* string region */
  457.    mmnewline();
  458.    fprintf(monfile, ">\n");        /* signal end of refresh */
  459.    mmsizes('=');            /* confirm region sizes */
  460.    mmforget();                /* clear memory of past sizes */
  461.    }
  462.  
  463. /*
  464.  *  mmstatic() - recap the static region (stack, coexprs, aliens, free)
  465.  *   (this function is empty under FixedRegions)
  466.  */
  467. static novalue mmstatic()
  468.    {
  469. #ifndef FixedRegions
  470.    HEADER *p;
  471.    char *a;
  472.    int h;
  473.    word n;
  474.  
  475.    for (p = (HEADER *)statbase; (uword)p < (uword)(HEADER *)statfree;
  476.       p += p->s.bsize) {
  477.          a = (char *)(p + 1);
  478.          n = (p->s.bsize - 1) * sizeof(HEADER);
  479.          h = *(int *)a;
  480.          if (h == T_Coexpr || a == (char *)stack)
  481.             MMStat(a, n, 'X');        /* coexpression block */
  482.          else if (h == FREEMAGIC)
  483.             MMStat(a, n, 'F');        /* free block */
  484.          else
  485.             MMStat(a, n, 'A');        /* alien block */
  486.          }
  487.    a = (char *)p;
  488.    if (a < statend)
  489.       MMStat(a, (word)(statend-a), 'F');/* rest of static region is free */
  490. #endif                    /* FixedRegions */
  491.    }
  492.  
  493. /*
  494.  * mmsizes(c) - output current region sizes, with initial character c.
  495.  * If c is '<', the unit size is written ahead of it.
  496.  */
  497. static novalue mmsizes(c)
  498. int c;
  499.    {
  500.    mmnewline();
  501.    if (c == '<')
  502.       fprintf(monfile, "%d", MMUnits);
  503.    fprintf(monfile, "%c %lu:%lu/%lu %lu:%lu/%lu %lu:%lu/%lu\n", c,
  504.       /* static region; show as full, actual amount is unknown */
  505.       (unsigned long)statbase,
  506.       (unsigned long)DiffPtrs(statend, statbase),
  507.       (unsigned long)DiffPtrs(statend, statbase),
  508.       /* string region */
  509.       (unsigned long)strbase,
  510.       (unsigned long)DiffPtrs(strfree, strbase),
  511.       (unsigned long)DiffPtrs(strend, strbase),
  512.       /* block region */
  513.       (unsigned long)blkbase,
  514.       (unsigned long)DiffPtrs(blkfree, blkbase),
  515.       (unsigned long)DiffPtrs(blkend, blkbase));
  516.    }
  517.  
  518. /*
  519.  * mmcmd(addr, len, c) - output a memmon command.
  520.  *  If addr is < 0, it is omitted.
  521.  *  If len matches the previous value for command c, it is also omitted.
  522.  *  If the output fills the line, a following newline is written.
  523.  */
  524.  
  525. static novalue mmcmd(addr, len, c)
  526. word addr, len;
  527. int c;
  528.    {
  529.    if (addr >= 0) {
  530.       mmdec((uword)addr);
  531.       mmchar('+');
  532.       }
  533.    mmlen(len, c);
  534.    if (llen >= LLIM)
  535.       mmnewline();
  536.    else
  537.       mmspace();
  538.    }
  539.  
  540. /*
  541.  * mmlen(n, c) - output length n with character c.
  542.  * Omit the length if it matches the previous value for c.
  543.  */
  544. static novalue mmlen(n, c)
  545. word n;
  546. int c;
  547.    {
  548.    if (n != curlength[c-CurBias])
  549.       mmdec((uword)(curlength[c-CurBias] = n));
  550.    mmchar(c); 
  551.    }
  552.  
  553. /*
  554.  * mmdec(n) - output a decimal value, updating the line length.
  555.  */
  556. static novalue mmdec (n)
  557. uword n;
  558.    {
  559.    if (n > 9)
  560.       mmdec(n / 10);
  561.    n %= 10;
  562.    mmchar('0'+(int)n);
  563.    }
  564.  
  565. /*
  566.  * mmnewline() - output a newline and reset the line length.
  567.  */
  568. static novalue mmnewline()
  569.    {
  570.    if (llen > 0)  {
  571.       putc('\n', monfile);
  572.       llen = 0;
  573.       }
  574.    }
  575.  
  576. /*
  577.  * mmforget() - clear the history of remembered lengths.
  578.  */
  579. static novalue mmforget()
  580.    {
  581.    int c;
  582.  
  583.    for (c = 0; c < CurSize; c++)
  584.       curlength[c] = -1;
  585.    }
  586. #else                    /* MemMon */
  587. static char x;            /* avoid empty module */
  588. #endif                    /* MemMon */
  589.